home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #48 (Sep 89) / Zoundz Source / MyFileStuff.Pas < prev    next >
Pascal/Delphi Source File  |  1989-04-28  |  6KB  |  220 lines
  1. unit MyFileStuff;
  2. interface
  3.     uses
  4.         PrintTraps, Sound, MyGlobals, Message, MySound;
  5.     procedure doSave;
  6.     procedure doSaveAs;
  7.     procedure OpenFile;
  8.     procedure doOpen;
  9.  
  10. implementation
  11.     const
  12.         SFPutLeft = 82;
  13.         SFPutTop = 50;
  14.         myType = 'ZZDC';
  15.         myCreator = 'KCZZ';
  16.     var
  17.         SFPutPt: Point;
  18.         theReply: SFReply;
  19.         refNum, resRef: integer;
  20.         bytes: longint;
  21.         title: str255;
  22.         theLength: longint;
  23.         theErr: OSErr;
  24.         theItem: integer;
  25.         oldHandle: Handle;
  26.  
  27.     function HandleError (theStr: Str255; theError: OSErr; chk, chksum: integer; CloseIt: boolean): boolean;
  28.         var
  29.             STemp: str255;
  30.     begin
  31.         if (theError <> noErr) then
  32.             begin
  33.                 A_Message(theStr, '', '', '', theItem);
  34.                 if CloseIt then
  35.                     begin
  36.                         theErr := FSClose(refNum);
  37.                         theErr := FlushVol(nil, VolRefNum);
  38.                     end;
  39.                 HandleError := true;
  40.             end
  41.         else if (chk <> chksum) then
  42.             begin
  43.                 A_Message(theStr, 'Checksum Error', '', '', theItem);
  44.                 if CloseIt then
  45.                     begin
  46.                         theErr := FSClose(refNum);
  47.                         theErr := FlushVol(nil, VolRefNum);
  48.                     end;
  49.                 HandleError := true;
  50.             end
  51.         else
  52.             HandleError := false;
  53.     end;
  54.  
  55.     procedure doSave;
  56.     begin
  57.         if VolRefNum = 0 then
  58.             begin {bad volume reference number}
  59.                 A_Message('Bad Volume Number', '', '', '', theItem);
  60.                 Exit(doSave);
  61.             end
  62.         else {good volume reference number}
  63.             begin
  64.                 theErr := FSOpen(FileName, VolRefNum, refNum);
  65.                 if HandleError('Could Not Open File', theErr, 0, 0, false) then
  66.                     Exit(doSave)
  67.                 else {file was open ok}
  68.                     begin
  69.                         theErr := SetFPos(refNum, FSFromStart, 0);
  70.                         if HandleError('Could Not Open File Position', theErr, 0, 0, true) then
  71.                             Exit(doSave)
  72.                         else {ready to go}
  73.                             begin
  74.                                 bytes := sizeof(DocRec);
  75.                                 theLength := bytes;
  76.                                 theErr := FSWrite(refNum, bytes, ptr(MyDoc));
  77.                                 if HandleError('Trouble Writing To File', theErr, bytes, theLength, true) then
  78.                                     Exit(doSave);
  79.                             end;
  80.                     end; {of file open ok}
  81.                 theErr := FSClose(refNum);
  82.  
  83.                 theErr := FlushVol(nil, VolRefNum);
  84.  
  85.                 theErr := SetVol(nil, VolRefNum);
  86.                 CreateResFile(FileName);
  87.                 resRef := OpenResFile(FileName);
  88.                 if resRef = -1 then
  89.                     begin {could not be opened}
  90.                         A_Message('Could not write sound to', FileName, '', '', theItem);
  91.                         Exit(doSave);
  92.                     end
  93.                 else {ready to write out sound}
  94.                     begin
  95.                         OldHandle := GetResource('snd ', 9000);
  96.                         if OldHandle <> nil then
  97.                             begin {existing sound to remove}
  98.                                 RmveResource(OldHandle);
  99.                                 DisposHandle(OldHandle);
  100.                                 UpdateResFile(resRef);
  101.                             end;
  102.                         CreateSndResource(MyDoc^.StartValue, MyDoc^.EndValue);
  103.                         AddResource(MyHandle, 'snd ', 9000, FileName);
  104.                         UpdateResFile(resRef);
  105.                         CloseResFile(resRef);
  106.                         DisposHandle(MyHandle);
  107.                         DisposHandle(Handle(MySoundHandle));
  108.                     end;
  109.  
  110.             end;{ of good vol ref num}
  111.     end;  {of doSave}
  112.  
  113.     procedure doSaveAs;
  114.     begin
  115.         SetPt(SFPutPt, SFPutLeft, SFPutTop);
  116.         GetWTitle(MyWindow, title);
  117.         SFPutFile(SFPutPt, 'Save Zoundz as…', title, nil, theReply);
  118.         if theReply.good then
  119.             begin
  120.                 theErr := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
  121.  
  122.                 if theErr <> noErr then {duplicate or problem}
  123.                     begin
  124.                         if theErr = dupFNerr then
  125.                             begin {duplicate}
  126.                                 theErr := FSDelete(theReply.fname, theReply.vRefNum);
  127.                                 if theErr <> noErr then
  128.                                     begin {cannot delete file}
  129.                                         A_Message('Cannot Delete File.', '', '', '', theItem);
  130.                                         Exit(doSaveAs);
  131.                                     end;
  132.                                 theErr := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
  133.                                 if theErr <> noErr then
  134.                                     begin {error in creating after deleting duplicate}
  135.                                         A_Message('Cannot Create', theReply.fname, '', '', theItem);
  136.                                         Exit(doSaveAs);
  137.                                     end;
  138.                             end
  139.                         else { a problem}
  140.                             begin
  141.                                 A_Message('Cannot Create', theReply.fname, '', '', theItem);
  142.                                 Exit(doSaveAs);
  143.                             end;
  144.  
  145.                     end {duplicate or problem}
  146.  
  147.                 else {ready to save}
  148.                     begin
  149.                         VolRefNum := theReply.vRefNum;
  150.                         FileName := theReply.fname;
  151.                         SetWTitle(MyWindow, FileName);
  152.                         theErr := FlushVol(nil, VolRefNum);
  153.                         doSave;
  154.                     end; {ready to save}
  155.             end; {good reply}
  156.  
  157.     end;
  158.  
  159.     procedure OpenFile;
  160.     begin
  161.         theErr := FSOpen(FileName, VolRefNum, refNum);
  162.         if HandleError('Could Not Open File', theErr, 0, 0, false) then
  163.             Exit(OpenFile)
  164.         else {file was open ok}
  165.             begin
  166.                 theErr := SetFPos(refNum, FSFromStart, 0);
  167.                 if HandleError('Could Not Open File Position', theErr, 0, 0, true) then
  168.                     begin
  169.                         VolRefNum := 0;
  170.                         Exit(OpenFile);
  171.                     end
  172.                 else {ready to go}
  173.                     begin
  174.                         bytes := sizeof(DocRec);
  175.                         theLength := bytes;
  176.  
  177.                         theErr := FSRead(refNum, bytes, ptr(MyDoc));
  178.                         if HandleError('Trouble Reading File', theErr, bytes, theLength, true) then
  179.                             begin
  180.                                 VolRefNum := 0;
  181.                                 Exit(OpenFile);
  182.                             end;
  183.                     end;
  184.             end; {of file open ok}
  185.         theErr := FSClose(refNum);
  186.         theErr := FlushVol(nil, VolRefNum);
  187.  
  188.         MyWindow := nil;                  {Make sure other routines know we are not valid yet}
  189.         NoteText := '1';
  190.         NumToString(MyDoc^.StartValue, StartText);
  191.         NumToString(MyDoc^.EndValue, EndText);
  192.         NumToString(MyDoc^.freq[1], FreqText);
  193.         NumToString(MyDoc^.amp[1], AmpText);
  194.         NumToString(MyDoc^.dur[1], DurText);
  195.         NumToString(MyDoc^.timbre[1], TimbreText);
  196.  
  197.         NoteIndex := 1;
  198.         DrawTool := 1;
  199.  
  200.         MySoundHandle := nil;
  201.         MyHandle := nil;
  202.     end;
  203.  
  204.     procedure doOpen;
  205.         var
  206.             theTypes: SFTypeList;
  207.     begin
  208.         SetPt(SFPutPt, SFPutLeft, SFPutTop);
  209.         theTypes[0] := myType;
  210.         SFGetFile(SFPutPt, 'Open Zoundz file…', nil, 1, theTypes, nil, theReply);
  211.         VolRefNum := 0;
  212.         if theReply.good then
  213.             begin
  214.                 VolRefNum := theReply.vRefNum;
  215.                 FileName := theReply.fName;
  216.                 OpenFile;
  217.             end;
  218.     end;
  219.  
  220. end.